(in-package :operations)

;;(labels (

(defun boxp (x)
  (or (listp x)
      (and (symbolp x)
           (char-equal (char (symbol-name x) 0) #\b))))

(defun c (selectp pattern)
  (labels ((helper (pat)
             (cond
               ((symbolp pat)
                (case (char (string pat) 0)
                  ((#\B #\b)
                   `(a nil ,pat))
                  ((#\X #\x) `(a nil (m (a nil))))
                  (t `(a ,pat ,(gensym "W")))))
               ((numberp pat)
                `(a ,pat ,(gensym "W")))
               ((and (listp pat)
                     (eq (first pat) :eval))
                `(a (:eval ,(rest pat))))
               ((listp pat)
                (if (eq (second pat) '=)
                    (cond
                      ((and (boxp (first pat))
                            (not (boxp (third pat))))
                       `(m (a ,(third pat)
                              ,(third (helper (first pat))))
                           :selected ,selectp))
                      ((and (boxp (third pat))
                            (not (boxp (first pat))))
                       `(m (a ,(first pat)
                              ,(third (helper (third pat))))
                           :selected ,selectp))
                      (t
                       `(m (a nil
                              ,(third (helper (first pat)))
                              ,(third (helper (third pat)))))))
                      `(a nil (m ,(helper (first pat))
                                 ,(helper (second pat))
                                 ,(helper (third pat))
                                 :selected ,selectp))))
               (t (error "bork.")))))
    (let ((r (helper pattern)))
      (if (eq (car r) 'a)
          (third r)
          r))))

(defun i (pattern)
  (labels ((getans (list)
             (let ((ans (getf (member-if 'keywordp list) :answer)))
               (if (and (listp ans)
                        (eq (first ans) :eval))
                   (second ans)
                   ans)))
           (fchar (symbol)
             (char-downcase (char (symbol-name symbol) 0)))
           (helper (pat)
             (cond
               ((symbolp pat)
                (cond
                  ((char= (fchar pat) #\b)
                   `(a nil ,pat))
                  ((char= (fchar pat) #\x)
                   `(a nil (m (a nil))))
                  ((find pat '(+ - / *))
                   `(oi nil :answer ,(string pat)))
                  ((find (fchar pat) "amo" :test 'char=)
                   `(oi nil :answer ,pat))
                  (t `(i nil :answer ,pat))))
               ((numberp pat)
                `(i nil :answer ,pat))
               ((and (listp pat)
                     (eq (first pat) :eval))
                `(i nil :answer (:eval ,(rest pat))))
               ((listp pat)
                (if (eq (second pat) '=)
                    (cond
                      ((and (boxp (first pat))
                            (not (boxp (third pat))))
                       `(m (i ,(third pat)
                              ,(third (helper (first pat))))))
                      ((and (boxp (third pat))
                            (not (boxp (first pat))))
                       `(m (i ,(first pat)
                              ,(third (helper (third pat))))))
                      (t
                       `(m (a nil
                              ,(third (helper (first pat)))
                              ,(third (helper (third pat)))))))
                    (let ((op (helper (second pat)))
                          (left (helper (first pat)))
                          (right (helper (third pat))))
                      
;;                       (cond
;;                         ((and (eq (first left) 'i)
;;                               (eq (first op) 'oi)
;;                               (eq (first right) 'i))
;;                          `(a nil (m (noni nil :answer (:eval (format nil "~a~a~a"
;;                                                                      ,(getans left)
;;                                                                      ,(getans op)
;;                                                                      ,(getans right)))))))
;;                         ((and (eq (first left) 'i)
;;                               (eq (first op) 'oi))
;;                          `(a nil (m (noi nil :answer (:eval (format nil "~a~a"
;;                                                                     ,(getans left)
;;                                                                     ,(getans op))))
;;                                     ,right)))
;;                         ((and (eq (first op) 'oi)
;;                               (eq (first right) 'i))
;;                          `(a nil (m ,left
;;                                     (oni nil :answer (:eval (format nil "~a~a"
;;                                                                     ,(getans op)
;;                                                                     ,(getans right)))))))
;;                         (t
                         `(a nil (m ,left ,op ,right)))))
               (t (error "b0rk: ~a" pat)))))
    (let ((r (helper pattern)))
      (if (eq (car r) 'a)
          (third r)
          r))))

(defun rule (before after &key hint mistake (surgeryp t))
  (make-instance 'o:transformation
                 :old-tree (c t before)
                 :new-tree (i after)
                 :hint hint
                 :mistake mistake
                 :surgeryp surgeryp))

(defun walk-tree (root function)
  (cond
    ((symbolp root)
     root)
    ((string= (first root) :m)
     (list* (first root)
            (mapcar (lambda (x) (walk-tree x function))
                    (mapcar function (cdr root)))))
    ((string= (first root) :a)
     (list* (first root) (second root)
            (walk-tree (funcall function (third root)) function)
            (copy-list (cdddr root))))
    ((find (first root) '(:i :ni :oi)
           :test 'string=)
     (list* (first root)
            (walk-tree (funcall function (second root)) function)
            (copy-list (cddr root))))
    (t (error "dunno how to handle ~s" root))))

(defun add-plists (transformation &rest input-plists)
  "INPUT-PLISTS is a list of keyword value pairs for each input
argument. It is ordered in the order they come up while traversing the
tree from the root, always searching the left branch first."
  (setf (o:new-tree transformation)
        (walk-tree (o:new-tree transformation)
                   (lambda (node)
                     (if (and (listp node)
                              (find (first node) '(:i :ni :oi) :test 'string=))
                         (append node (pop input-plists))
                         node))))
  transformation)

(defun evaluate-transformations ()
  (list
   (make-instance 'o:transformation
                  :old-tree '(a nil (m (a n1) (a op) (a n2) :selected t))
                  :new-tree '(i nil (m (a n1) (a op) (a n2)) :answer (:eval (funcall op n1 n2))))
   (make-instance 'o:transformation
                  :old-tree '(a nil (m (a n1) :selected t))
                  :new-tree '(i nil (m (a n1)) :answer n1))
   (make-instance 'o:transformation
                  :old-tree '(a nil b (m (a n1) (a op) (a n2) :selected t))
                  :new-tree '(i nil b (m (a n1) (a op) (a n2)) :answer (:eval (funcall op n1 n2))))))

(defun invert-transformations ()
  (list
   ;; addition
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 = (n2 + b)))
                  :new-tree (i '(b = (n1 - n2))))
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 = (b + n2)))
                  :new-tree (i '(b = (n1 - n2))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 + b) = n1))
                  :new-tree (i '(b = (n1 - n2))))
   (make-instance 'o:transformation
                  :old-tree (c t '((b + n2) = n1))
                  :new-tree (i '(b = (n1 - n2))))
   ;; subtraction
   ;; normal case
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 = (b - n2)))
                  :new-tree (i '(b = (n1 + n2))))
   (make-instance 'o:transformation
                  :old-tree (c t '((b - n2) = n1))
                  :new-tree (i '(b = (n1 + n2))))
   ;; special case
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 = (n2 - b)))
                  :new-tree (i '(b = (n2 - n1))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 - b) = n1))
                  :new-tree (i '(b = (n2 - n1))))
   ;; multiplication
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 = (n2 * b)))
                  :new-tree (i '(b = (n1 / n2))))
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 = (b * n2)))
                  :new-tree (i '(b = (n1 / n2))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 * b) = n1))
                  :new-tree (i '(b = (n1 / n2))))
   (make-instance 'o:transformation
                  :old-tree (c t '((b * n2) = n1))
                  :new-tree (i '(b = (n1 / n2))))
   ;; division
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 = (b / n2)))
                  :new-tree (i '(b = (n1 * n2))))
   (make-instance 'o:transformation
                  :old-tree (c t '((b / n2) = n1))
                  :new-tree (i '(b = (n1 * n2))))))

(defun basic-combine-transformations ()
  (list
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 + (n2 + b)))
                  :new-tree  (i '((n2 + n1) + b)))
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 + (b + n2)))
                  :new-tree (i '((n2 + n1) + b)))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 + b) + n1))
                  :new-tree  (i '((n2 + n1) + b)))
   (make-instance 'o:transformation
                  :old-tree (c t '((b + n2) + n1))
                  :new-tree  (i '((n2 + n1) + b)))
   ;; +-
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 + (n2 - b)))
                  :new-tree  (i '((n2 + n1) - b)))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 - b) + n1))
                  :new-tree  (i '((n2 + n1) - b)))
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 + (b - n2)))
                  :new-tree  (i '(((:eval - n2) + n1) + b)))
   (make-instance 'o:transformation
                  :old-tree (c t '((b - n2) + n1))
                  :new-tree  (i '(((:eval - n2) + n1) + b)))
   ;; -+
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 - (n2 + b)))
                  :new-tree  (i '((n1 - n2) - b)))
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 - (b + n2)))
                  :new-tree  (i '((n1 - n2) - b)))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 + b) - n1))
                  :new-tree  (i '((n2 - n1) + b)))
   ;; FIXME: The box is on the left for this one. There is no reason
   ;; for it other than that it's always been this way.
   (make-instance 'o:transformation
                  :old-tree (c t '((b + n2) - n1))
                  :new-tree  (i '(b + (n2 - n1))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 - b) - n1))
                  :new-tree  (i '((n2 - n1) - b)))
   (make-instance 'o:transformation
                  :old-tree (c t '((b - n2) - n1))
                  :new-tree  (i '(b + ((:eval - n2) - n1))))
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 - (n2 - b)))
                  :new-tree  (i '((n1 - n2) + b)))
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 - (b - n2)))
                  :new-tree  (i '((n1 - (:eval - n2)) - b)))
   ;; **
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 * (n2 * b)))
                  :new-tree  (i '((n1 * n2) * b)))
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 * (b * n2)))
                  :new-tree  (i '((n1 * n2) * b)))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 * b) * n1))
                  :new-tree  (i '((n1 * n2) * b)))
   (make-instance 'o:transformation
                  :old-tree (c t '((b * n2) * n1))
                  :new-tree  (i '((n1 * n2) * b)))
   ;; */
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 * b) / n1))
                  :new-tree  (i '((n2 / n1) * b)))))

(defun x-combine-transformations ()
  (list
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 * x) + (n2 * x)))
                  :new-tree (i '((n1 + n2) * x)))
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 * x) - (n2 * x)))
                  :new-tree (i '((n1 - n2) * x)))))

(defun x-combine2-transformations ()
  (list
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 * x) + (n3 + (n2 * x))))
                  :new-tree (i '(n3 + ((n1 + n2) * x))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 * x) + (n3 - (n2 * x))))
                  :new-tree (i '(n3 + ((n1 + (:eval - n2)) * x))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 * x) + ((n2 * x) + n3)))
                  :new-tree (i '(n3 + ((n1 + n2) * x))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 * x) + ((n2 * x) - n3)))
                  :new-tree (i '((:eval - n3) + ((n1 + n2) * x))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n3 + (n2 * x)) + (n1 * x)))
                  :new-tree (i '(n3 + ((n2 + n1) * x))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n3 - (n2 * x)) + (n1 * x)))
                  :new-tree (i '(n3 + (((:eval - n2) + n1) * x))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n3 + (n2 * x)) - (n1 * x)))
                  :new-tree (i '(n3 + ((n2 - n1) * x))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n3 - (n2 * x)) - (n1 * x)))
                  :new-tree (i '(n3 + (((:eval - n2) - n1) * x))))
   (make-instance 'o:transformation
                  :old-tree (c t '(((n2 * x) + n3) + (n1 * x)))
                  :new-tree (i '(n3 + ((n2 + n1) * x))))
   (make-instance 'o:transformation
                  :old-tree (c t '(((n2 * x) + n3) - (n1 * x)))
                  :new-tree (i '(n3 + ((n2 - n1) * x))))
   (make-instance 'o:transformation
                  :old-tree (c t '(((n2 * x) - n3) + (n1 * x)))
                  :new-tree (i '((:eval - n3) + ((n2 + n1) * x))))
   (make-instance 'o:transformation
                  :old-tree (c t '(((n2 * x) - n3) - (n1 * x)))
                  :new-tree (i '((:eval - n3) + ((n2 - n1) * x))))
   ;; cases that could be transformed by undo-minus
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 * x) - ((n2 * x) - n3)))
                  :new-tree (i '(((n1 - n2) * x) - (:eval - n3))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 * x) - (n3 - (n2 * x))))
                  :new-tree (i '(((n1 - (:eval - n2)) * x) - n3)))
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 * x) - ((n2 * x) + n3)))
                  :new-tree (i '(((n1 - n2) * x) - n3)))
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 * x) - (n3 + (n2 * x))))
                  :new-tree (i '(((n1 - n2) * x) - n3)))))

(defun 5box-combine-transformations ()
  (list
   (make-instance 'o:transformation
                  :old-tree (c t '(((n1 * x) + n2) + ((n3 * x) + n4)))
                  :new-tree (i '(((n1 + n3) * x) + (n2 + n4))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 + (n1 * x)) + ((n3 * x) + n4)))
                  :new-tree (i '(((n1 + n3) * x) + (n2 + n4))))
   (make-instance 'o:transformation
                  :old-tree (c t '(((n1 * x) + n2) + (n4 + (n3 * x))))
                  :new-tree (i '(((n1 + n3) * x) + (n2 + n4))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 + (n1 * x)) + (n4 + (n3 * x))))
                  :new-tree (i '(((n1 + n3) * x) + (n2 + n4))))

   (make-instance 'o:transformation
                  :old-tree (c t '(((n1 * x) + n2) + ((n3 * x) - n4)))
                  :new-tree (i '(((n1 + n3) * x) + (n2 + (:eval - n4)))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 + (n1 * x)) + ((n3 * x) - n4)))
                  :new-tree (i '(((n1 + n3) * x) + (n2 + (:eval - n4)))))
   (make-instance 'o:transformation
                  :old-tree (c t '(((n1 * x) + n2) + (n4 - (n3 * x))))
                  :new-tree (i '(((n1 + (:eval - n3)) * x) + (n2 + n4))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 + (n1 * x)) + (n4 - (n3 * x))))
                  :new-tree (i '(((n1 + (:eval - n3)) * x) + (n2 + n4))))

   (make-instance 'o:transformation
                  :old-tree (c t '(((n1 * x) + n2) - ((n3 * x) + n4)))
                  :new-tree (i '(((n1 - n3) * x) + (n2 - n4))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 + (n1 * x)) - ((n3 * x) + n4)))
                  :new-tree (i '(((n1 - n3) * x) + (n2 - n4))))
   (make-instance 'o:transformation
                  :old-tree (c t '(((n1 * x) + n2) - (n4 + (n3 * x))))
                  :new-tree (i '(((n1 - n3) * x) + (n2 - n4))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 + (n1 * x)) - (n4 + (n3 * x))))
                  :new-tree (i '(((n1 - n3) * x) + (n2 - n4))))

   (make-instance 'o:transformation
                  :old-tree (c t '(((n1 * x) + n2) - ((n3 * x) - n4)))
                  :new-tree (i '(((n1 - n3) * x) + (n2 - (:eval - n4)))))
   (make-instance 'o:transformation
                  :old-tree (c t '(((n1 * x) + n2) - (n4 - (n3 * x))))
                  :new-tree (i '(((n1 - (:eval - n3)) * x) + (n2 - n4))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 + (n1 * x)) - ((n3 * x) - n4)))
                  :new-tree (i '(((n1 - n3) * x) + (n2 - (:eval - n4)))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 + (n1 * x)) - (n4 - (n3 * x))))
                  :new-tree (i '(((n1 - (:eval - n3)) * x) + (n2 - n4))))

   (make-instance 'o:transformation
                  :old-tree (c t '(((n1 * x) - n2) + ((n3 * x) + n4)))
                  :new-tree (i '(((n1 + n3) * x) + ((:eval - n2) + n4))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 - (n1 * x)) + ((n3 * x) + n4)))
                  :new-tree (i '((((:eval - n1) + n3) * x) + (n2 + n4))))
   (make-instance 'o:transformation
                  :old-tree (c t '(((n1 * x) - n2) + (n4 + (n3 * x))))
                  :new-tree (i '(((n1 + n3) * x) + ((:eval - n2) + n4))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 - (n1 * x)) + (n4 + (n3 * x))))
                  :new-tree (i '((((:eval - n1) + n3) * x) + (n2 + n4))))

   (make-instance 'o:transformation
                  :old-tree (c t '(((n1 * x) - n2) + ((n3 * x) - n4)))
                  :new-tree (i '(((n1 + n3) * x) + ((:eval - n2) + (:eval - n4)))))
   (make-instance 'o:transformation
                  :old-tree (c t '(((n1 * x) - n2) + (n4 - (n3 * x))))
                  :new-tree (i '(((n1 + (:eval - n3)) * x) + ((:eval - n2) + n4))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 - (n1 * x)) + ((n3 * x) - n4)))
                  :new-tree (i '((((:eval - n1) + n3) * x) + (n2 + (:eval - n4)))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 - (n1 * x)) + (n4 - (n3 * x))))
                  :new-tree (i '((((:eval - n1) + (:eval - n3)) * x) + (n2 + n4))))

   (make-instance 'o:transformation
                  :old-tree (c t '(((n1 * x) - n2) - ((n3 * x) + n4)))
                  :new-tree (i '(((n1 - n3) * x) + ((:eval - n2) + (:eval - n4)))))
   (make-instance 'o:transformation
                  :old-tree (c t '(((n1 * x) - n2) - (n4 + (n3 * x))))
                  :new-tree (i '(((n1 - n3) * x) + ((:eval - n2) - n4))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 - (n1 * x)) - ((n3 * x) + n4)))
                  :new-tree (i '((((:eval - n1) - n3) * x) + (n2 - n4))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 - (n1 * x)) - (n4 + (n3 * x))))
                  :new-tree (i '((((:eval - n1) - n3) * x) + (n2 - n4))))

   (make-instance 'o:transformation
                  :old-tree (c t '(((n1 * x) - n2) - ((n3 * x) - n4)))
                  :new-tree (i '(((n1 - n3) * x) + ((:eval - n2) - (:eval - n4)))))
   (make-instance 'o:transformation
                  :old-tree (c t '(((n1 * x) - n2) - (n4 - (n3 * x))))
                  :new-tree (i '(((n1 - (:eval - n3)) * x) + ((:eval - n2) - n4))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 - (n1 * x)) - ((n3 * x) - n4)))
                  :new-tree (i '((((:eval - n1) - n3) * x) + (n2 - (:eval - n4)))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 - (n1 * x)) - (n4 - (n3 * x))))
                  :new-tree (i '((((:eval - n1) - (:eval - n3)) * x) + (n2 - n4))))))

(defun weird-combine-transformations ()
  (list
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 * x) - x))
                  :new-tree (i '((n1 - 1) * x)))
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 * x) + x))
                  :new-tree (i '((n1 + 1) * x)))
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 * x) - (x - n2)))
                  :new-tree (i '(((n1 - 1) * x) - (:eval - n2))))
   (make-instance 'o:transformation
                  :old-tree (c t '((x + n2) + (n1 * x)))
                  :new-tree (i '(((1 + n1) * x) + n2)))
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 - (n2 * x)) + x))
                  :new-tree (i '((((:eval - n2) + 1) * x) + n1)))

   (make-instance 'o:transformation
                  :old-tree (c t '(((n1 * x) + n2) - (x - n3)))
                  :new-tree (i '(((n1 - 1) * x) + (n2 - (:eval - n3)))))
   (make-instance 'o:transformation
                  :old-tree (c t '(((n1 * x) - n2) - (x - n3)))
                  :new-tree (i '(((n1 - 1) * x) + ((:eval - n2) - (:eval - n3)))))

   (make-instance 'o:transformation
                  :old-tree (c t '((n1 * x) - (n2 - x)))
                  :new-tree (i '(((n1 - -1) * x) - n2)))

   (make-instance 'o:transformation
                  :old-tree (c t '((n1 - (n2 * x)) - (x - n3)))
                  :new-tree (i '((((:eval - n2) - 1) * x) + (n1 - (:eval - n3)))))))
   
(defun switch2-transformations ()
  (list
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 + b1) + (n3 + b2)))
                  :new-tree (i '(((n1 + n3) + b1) + b2)))
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 + b1) + (n3 - b2)))
                  :new-tree (i '(((n1 + n3) + b1) - b2)))
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 - b1) + (n3 + b2)))
                  :new-tree (i '(((n1 + n3) - b1) + b2)))
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 - b1) + (n3 - b2)))
                  :new-tree (i '(((n1 + n3) - b1) - b2)))
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 + b1) + (b2 + n3)))
                  :new-tree (i '(((n1 + n3) + b1) + b2)))
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 + b1) + (b2 - n3)))
                  :new-tree (i '(((n1 + (:eval - n3)) + b1) + b2)))
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 - b1) + (b2 + n3)))
                  :new-tree (i '(((n1 + n3) - b1) + b2)))
   (make-instance 'o:transformation
                  :old-tree (c t '((n1 - b1) + (b2 - n3)))
                  :new-tree (i '(((n1 + (:eval - n3)) - b1) + b2)))
   (make-instance 'o:transformation
                  :old-tree (c t '((b1 + n1) + (n3 + b2)))
                  :new-tree (i '(((n1 + n3) + b1) + b2)))
   (make-instance 'o:transformation
                  :old-tree (c t '((b1 + n1) + (n3 - b2)))
                  :new-tree (i '(((n1 + n3) + b1) - b2)))
   (make-instance 'o:transformation
                  :old-tree (c t '((b1 - n1) + (n3 + b2)))
                  :new-tree (i '((((:eval - n1) + n3) + b1) + b2)))
   (make-instance 'o:transformation
                  :old-tree (c t '((b1 - n1) + (n3 - b2)))
                  :new-tree (i '((((:eval - n1) + n3) + b1) - b2)))
   (make-instance 'o:transformation
                  :old-tree (c t '((b1 + n1) + (b2 + n3)))
                  :new-tree (i '(((n1 + n3) + b1) + b2)))
   (make-instance 'o:transformation
                  :old-tree (c t '((b1 + n1) + (b2 - n3)))
                  :new-tree (i '(((n1 + (:eval - n3)) + b1) + b2)))
   (make-instance 'o:transformation
                  :old-tree (c t '((b1 - n1) + (b2 + n3)))
                  :new-tree (i '((((:eval - n1) + n3) + b1) + b2)))
   (make-instance 'o:transformation
                  :old-tree (c t '((b1 - n1) + (b2 - n3)))
                  :new-tree (i '((((:eval - n1) + (:eval - n3)) + b1) + b2)))))

(defun reorder-transformations ()
  (list
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 * (n2 a b)))
                  :new-tree (i '((n1 * n2) a (n1 * b))))
   (make-instance 'o:transformation
                  :old-tree (c t '((n2 a b) * n1))
                  :new-tree (i '((n1 * n2) a (n1 * b))))
   (make-instance 'o:transformation
                  :old-tree (c t '(n1 * (b a n2)))
                  :new-tree (i '((n1 * b) a (n1 * n2))))
   (make-instance 'o:transformation
                  :old-tree (c t '((b a n2) * n1))
                  :new-tree (i '((n1 * b) a (n1 * n2))))))

(defun subtract-transformations ()
  (list
   (make-instance 'o:transformation
                  :old-tree '(m (a nil b1 b2) :selected t)
                  :new-tree '(m (i nil (m (a nil b1) (oi nil :answer "-") (a nil b2)) :answer "0")))))
